﻿(*
    Turing machine implemented in F#
    -------------------------------------------------------------------------------
    Copyright © Lukas Kouril 2011 | http://www.lukaskouril.cz
    
    The source-code is available under the Microsoft Reciprocal License (Ms-RL)
    More information and documentation can be found at http://fsai.codeplex.com
*)

namespace FSharp.AI

exception PositionException of string
exception TapeReadException of string
exception TapeWriteException of string
exception InnerStateException of string

type IRunTM =
    abstract member fsRun : int -> int -> char[] -> char list -> int -> int[][][] -> int -> char[]
    abstract member olRun : int -> int -> char[] -> System.Collections.Generic.List<char> -> int -> int[][][] -> int -> char[]

type TM () = 

    interface IRunTM with
        member this.fsRun (state : int) (position : int) (tape : char[]) (symbols : char list) (F : int) (rules : int[][][]) (iterations : int) : char[] =
            this.RunTM state position tape symbols F rules iterations

        member this.olRun (state : int) (position : int) (tape : char[]) (symbols : System.Collections.Generic.List<char>) (F : int) (rules : int[][][]) (iterations : int) : char[] =
            this.RunTM state position tape  (Seq.toList symbols) F rules iterations

    member this.Run (state, position, tape, symbols, F, rules, iterations) = (this :> IRunTM).fsRun state position tape symbols F rules iterations
    member this.Run (state, position, tape, symbols, F, rules, iterations) = (this :> IRunTM).olRun state position tape symbols F rules iterations

    member private this.Read (position : int) (tape : char[]) =
        if (position - 1) >= tape.Length then raise (TapeReadException "An error occured while reading the tape!")
        else
            tape.[position - 1]

    member private this.Write (symbol : char) (position : int) (tape : char[]) =
        if (position - 1) >= tape.Length then raise (TapeWriteException "An error occured while writing the tape!")
        else        
            let tempTape = Array.copy tape
            tempTape.[position - 1] <- symbol
            tempTape

    member private this.FindIndex (symbol : char) (symbols : char list) =
        let mutable position : int = 0
        for i = symbols.Length - 1 downto 0 do
            if symbol = symbols.[i] then position <- i
        position

    member private this.RunTM (state : int) (position : int) (tape : char[]) (symbols : char list) (F : int) (rules : int[][][]) (iterations : int) : char[] =
        if (state - 1) >= rules.Length then raise (InnerStateException "An inappropriate inner state occured!")
        else        
            let iterationCounter = ref 0
            let tempTape = ref (Array.copy tape)
            let headPosition = ref position
            let mutable rule = rules.[state - 1].[List.findIndex (fun elem -> elem = (this.Read !headPosition !tempTape)) symbols]

            while ((rule.[0] <> F) && (!iterationCounter <= iterations)) do

                if ((!headPosition > tape.Length) || (!headPosition < 0)) then raise (PositionException "Position of the head is out of data tape!")

                tempTape := (this.Write symbols.[rule.[1] - 1] !headPosition !tempTape)
                headPosition := !headPosition + rule.[2]
                iterationCounter := !iterationCounter + 1

                if (rule.[0] - 1) >= rules.Length then raise (InnerStateException "An inappropriate inner state occured!")
                else
                    rule <- rules.[rule.[0] - 1].[List.findIndex (fun elem -> elem = (this.Read !headPosition !tempTape)) symbols]

            !tempTape